home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / think.tcl < prev    next >
Text File  |  1995-06-01  |  8KB  |  328 lines
  1.  
  2. proc thinkMenu {} {}
  3.  
  4. # The menu
  5. menu -n $thinkMenu {
  6.     "/S<O<Uthink"
  7.     "openHeader"
  8.     "menu -n thinkFlags {}"
  9.     "createThinkFileset"
  10.     "(-"
  11.     "/K<O<Ucompile"
  12.     "checkSyntax"
  13.     "/T<O<UsearchNextFile"
  14.     "(-"
  15.     "add"
  16.     "addAndCompile"
  17.     "(-"
  18.     "disassemble"
  19.     "preprocess"
  20.     "precompile"
  21.     "(-"
  22.     "bringUpToDate"
  23.     "/\\<O<Umake"
  24.     "(-"
  25.     "/I<O<Udebug"
  26.     "/R<O<Urun"
  27. }
  28.  
  29.  
  30. # The following flags affect Think's "Run" command.
  31. # THINK will crash if you set the debugger flag and your 
  32. # project does not have debugging information. 
  33. if {![info exists thinkdebugger]}     {set thinkdebugger     0}
  34. if {![info exists thinkgo]}         {set thinkgo         1}
  35. if {![info exists thinksaveDirty]}     {set thinksaveDirty    1}
  36. if {![info exists thinkupdate]}     {set thinkupdate     1}
  37.  
  38. menu -n thinkFlags -p thinkFlagsProc {"debugger" "go" "saveDirty" "update"}
  39. markMenuItem thinkFlags debugger     $thinkdebugger
  40. markMenuItem thinkFlags go             $thinkgo
  41. markMenuItem thinkFlags saveDirty    $thinksaveDirty
  42. markMenuItem thinkFlags update         $thinkupdate
  43.  
  44. proc thinkFlagsProc {menu item} {
  45.     global think$item modifiedVars
  46.     
  47.     set think$item [expr -1 * ([set think$item] - 1)]
  48.     markMenuItem thinkFlags $item [set think$item]
  49.     lappend modifiedVars think$item
  50. }
  51.  
  52. set THINK "THINK Project Manager"
  53. #set THINK "AEvent Display 1.3"
  54.  
  55.  
  56. proc thinkNumFiles {} {
  57.     global THINK
  58.     set str [AEBuild -r $THINK "core" "cnte" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('SFIL')"]
  59.     if {[regexp {[0-9]+} $str mtch]} {
  60.         return $mtch
  61.     } else {
  62.         error "Bad numfiles"
  63.     }
  64. }
  65.  
  66.  
  67.  
  68. # Get list of files in current project.
  69. proc projectFileList args {
  70.     watchCursor
  71.     checkRunning ThinkC KAHL thinkName
  72.     set num [thinkNumFiles]
  73.     set files {}
  74.  
  75.     for {set i 1} {$i<=$num} {incr i} {
  76.         set f [thinkFileName $i]
  77.         if {[getFileType $f] == "TEXT"} {
  78.             lappend files $f
  79.         }
  80.     }
  81.  
  82.     return $files
  83. }
  84.  
  85.  
  86.  
  87.  
  88. #================================================================================
  89.  
  90.  
  91. proc think {} {
  92.     set name [checkRunning ThinkC KAHL thinkName]
  93.     if {![string length $name]} return
  94.     switchTo $name
  95. }
  96.  
  97. proc searchNextFile {} {
  98.     thinkFinf
  99. }
  100.  
  101.  
  102.  
  103. #===========================================================================
  104. # Add fileset.
  105. #===========================================================================
  106. proc createThinkFileset {} {
  107.     global fileSets
  108.     global currFileSet
  109.     
  110.     set name [prompt "Fileset name? " "THINK"]
  111.     set fileSets($name) [lsort -command sortByTail [projectFileList]]
  112.     addMenuItem -m choose $name
  113.     set currFileSet $name
  114.  
  115.     if {[askyesno "Save project fileset?"] == "yes"} {
  116.         addArrDef fileSets $name $fileSets($name)
  117.     }
  118.     rebuildFilesetMenu
  119. }
  120.  
  121. #================================================================================
  122.  
  123. proc compile {} {
  124.     sendCompileEvent CMPL "-r"
  125. }
  126.  
  127. proc checkSyntax {} {
  128.     sendCompileEvent SNTX "-q"
  129. }
  130.  
  131. proc disassemble {} {
  132.     global THINK ALPHA
  133.     set tname [checkRunning ThinkC KAHL thinkName]
  134.     set name [lindex [winNames -f] 0]
  135.     switchTo $tname
  136.     set res [AEBuild -t 7200 -r $tname KAHL DASM CFLG long(32) "----" [fileObject $name]]
  137.     switchTo $ALPHA
  138.     new -n "* [file root [file tail $name]].asm *"
  139.     regexp {╥.*╙} $res text
  140.     insertText [string trim $text {╥╙}]
  141.     setWinInfo dirty 0
  142.     goto 0
  143. }
  144.  
  145. proc preprocess {} {
  146.     global THINK ALPHA
  147.     set tname [checkRunning ThinkC KAHL thinkName]
  148.     set name [lindex [winNames -f] 0]
  149.     switchTo $tname
  150.     set res [AEBuild -r $tname KAHL PRCS CFLG long(32) "----" [fileObject $name]]
  151.     switchTo $ALPHA
  152.     new -n "* Preprocessed '[file tail $name]' *"
  153.     regexp {╥.*╙} $res text
  154.     insertText [string trim $text {╥╙}]
  155. }
  156.  
  157.  
  158. proc sendCompileEvent {event arg} {
  159.     global THINK ALPHA
  160.  
  161.     set tname [checkRunning ThinkC KAHL thinkName]
  162.     set name [lindex [winNames -f] 0]
  163.     switchTo $tname
  164.     if {[string length $arg]} {
  165.         set err [catch {AEBuild -t 7200 $arg $tname KAHL  $event "----" [fileObject $name]} res]
  166.     } else {
  167.         set err [catch {AEBuild -t 7200 $tname KAHL  $event "----" [fileObject $name]} res]
  168.     }
  169.     if (!$err) {
  170.         set err [catch {switchTo $ALPHA} res]
  171.     }
  172.     if ($err) {
  173.         message $res
  174.     } else {
  175.         return $res
  176.     }
  177. }
  178.  
  179.  
  180. proc add {} {
  181.     global THINK
  182.     set fname [lindex [winNames -f] 0]
  183.     AEBuild $THINK core crel "data" [makeAlis $fname] "kocl" "type('SFIL')"
  184. }
  185.  
  186. proc addAndCompile {} {
  187.     add
  188.     compile
  189. }
  190.  
  191.  
  192. proc precompile {} {
  193.     sendCompileEvent PCMP ""
  194. }
  195.  
  196. proc bringUpToDate {} {
  197.     global THINK ALPHA
  198.     set name [checkRunning ThinkC KAHL thinkName]
  199.     switchTo $name
  200.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  201.     switchTo $ALPHA
  202.     return $res
  203. }
  204.  
  205. proc make {} {
  206.     global THINK ALPHA
  207.     set name [checkRunning ThinkC KAHL thinkName]
  208.     switchTo $name
  209.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  210. }
  211.  
  212. proc run {} {
  213.     global THINK thinkdebugger thinkgo thinksaveDirty thinkupdate
  214.     
  215.     set name [checkRunning ThinkC KAHL thinkName]
  216.     set dbug [expr {$thinkdebugger ? "bool(╟01╚)" : "bool(╟00╚)"}]
  217.     set go [expr {$thinkgo ? "bool(╟01╚)" : "bool(╟00╚)"}]
  218.     set update [expr {$thinkupdate ? "'yes '" : "'no  '"}]
  219.     set dirty [expr {$thinksaveDirty ? "'yes '" : "'no  '"}]
  220.     if {[catch {switchTo $name}]} {
  221.         message "Error switching to TPM"
  222.         return
  223.     }
  224.     if {[catch {AEBuild -q $name KAHL "RUN " "DBUG" $dbug  "GO  " $go "UPDT" $update "savo" $dirty} res]} {
  225.         message $res
  226.     }
  227. }
  228.  
  229. proc debug {} {
  230.     global THINK 
  231.     switchTo '╫LSD'
  232.     set fname [lindex [winNames -f] 0]
  233.     set row [expr [lindex [posToRowCol [getPos]] 0] - 1]
  234.     if {[catch {AEBuild $THINK KAHL DBGF "----" [makeAlis $fname] LNNO "short($row)" } res]} {
  235.         message $res
  236.     }
  237. }
  238.  
  239. proc cnt {} {
  240.     global THINK
  241.     AEBuild -t 6000 -r $THINK core cnte "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('sfil')"
  242. }
  243.  
  244. proc thinkFileName {arg} {
  245.     global THINK
  246.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'indx',\ seld:} $arg {\},\ form:'prop',\ seld:type('FSS\ ')\}}] ""]
  247.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  248.     regexp {╟.*╚} $blah blah
  249.     return [specToPathName [string trim $blah {╟╚}]]
  250. }
  251.  
  252. proc thinkInclude {name} {
  253.     global THINK thinkpaths
  254.     if {[info exists thinkpaths]} {unset thinkpaths}
  255.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'name', seld:╥} [file tail $name] {╙\},\ form:'prop',\ seld:type('INCL')\}}] ""]
  256.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  257.     if {![regexp {╟} $blah]} {return {{(No includes}}}
  258.     regsub -all {╚[^╟]*╟} $blah { } raw
  259.     regsub {[^╟]*╟} $raw {} raw
  260.     regsub {╚.*} $raw {} raw
  261.     foreach f $raw {
  262.         set path [specToPathName $f]
  263.         set tl [file tail $path]
  264.         set thinkpaths($tl) $path
  265.         lappend names $tl
  266.     }
  267.     return [lsort -ignore $names]
  268. }
  269.  
  270. # Called by Alpha to get list of include files for popup.
  271. proc thinkIncludeFiles {} {
  272.     if {[catch {thinkInclude [lindex [winNames] 0]} ret]} {
  273.         return {{(* THINK not running *}}
  274.     }
  275.     return $ret
  276. }
  277.  
  278. # Called by Alpha to edit result of popup
  279. proc thinkEditFile {name} {
  280.     global thinkpaths
  281.     
  282.     edit $thinkpaths($name)
  283. }
  284.  
  285. proc openHeader {} {
  286.     global thinkpaths
  287.  
  288.     set name [lindex [winNames] 0]
  289.     if {![string length $name]} return
  290.     if {[catch {thinkInclude $name} names]} {
  291.         message "Think not running!" 
  292.         beep
  293.         return
  294.     }
  295.     if {![string length $name] || [string match {(*} [lindex $names 0]]} {
  296.         message "No headers."
  297.         beep
  298.         return
  299.     }
  300.     set res [listpick -p {Include File?} $names]
  301.     if {[string length $res]} {edit $thinkpaths($res)}
  302. }
  303.         
  304.  
  305. #================================================================================
  306.         
  307. proc handleThinkReply { l } {
  308.     global thinkErrors teIndex ALPHA tileLeft tileTop tileWidth tileHeight winModes terrMenu errorHeight
  309.     set thinkErrors $l
  310.     switchTo $ALPHA
  311.     set teIndex 0
  312.     
  313.     foreach err $l {
  314.         append lines "\"[file tail [lindex $err 0]]\"; " [format "Line %d: " [lindex $err 2]] [lindex $err 1] "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t░[lindex $err 0]░[lindex $err 1]\r"
  315.     }
  316.  
  317.     new -n "* Compiler Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight
  318.  
  319.     insertText "(<cr> to go to error)\r-----\r" $lines
  320.     downBrowse
  321.     setWinInfo dirty 0
  322.     
  323.     global winModes
  324.     set name [lindex [winNames] 0]
  325.     changeMode [set winModes($name) Brws]
  326. }
  327.  
  328.